Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/odlist/odlist.frm

Text File | 1994-12-06 | 12KB | 342 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB Messenger Owner-Draw ListBox Sample"
   ClientHeight    =   5415
   ClientLeft      =   6135
   ClientTop       =   2970
   ClientWidth     =   7755
   Height          =   5820
   Left            =   6075
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5415
   ScaleWidth      =   7755
   Top             =   2625
   Width           =   7875
   Begin ListBox List1
      Height          =   2370
      Left            =   180
      TabIndex        =   8
      Top             =   2430
      Width           =   3495
   End
   Begin PictureBox picFile
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   195
      Left            =   3300
      Picture         =   ODLIST.FRX:0000
      ScaleHeight     =   195
      ScaleWidth      =   195
      TabIndex        =   7
      Top             =   5970
      Width           =   195
   End
   Begin PictureBox picDir
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   195
      Left            =   3060
      Picture         =   ODLIST.FRX:00E2
      ScaleHeight     =   195
      ScaleWidth      =   195
      TabIndex        =   6
      Top             =   5970
      Width           =   195
   End
   Begin CommandButton Command1
      Cancel          =   -1  'True
      Caption         =   "End Demo"
      Default         =   -1  'True
      Height          =   435
      Left            =   2970
      TabIndex        =   1
      Top             =   4890
      Width           =   1575
   End
   Begin VBMsg VBMsg1
      Height          =   420
      Left            =   7140
      MessageCount    =   ODLIST.FRX:01C4
      MessageList     =   ODLIST.FRX:01C6
      MessageTypes    =   0  'Selected Messages
      PostDefault     =   0   'False
      Top             =   4830
      Width           =   420
   End
   Begin Frame Frame1
      Caption         =   "Description"
      Height          =   4665
      Left            =   3810
      TabIndex        =   2
      Top             =   120
      Width           =   3795
      Begin Label Label3
         BackStyle       =   0  'Transparent
         Caption         =   "This sample program uses VB Messenger to trap the WM_DRAWITEM message that gets sent to the form (the parent of the list box) and draws a picture with text for each item.  This sample also uses the Windows API extensively."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   1035
         Left            =   180
         TabIndex        =   5
         Top             =   3450
         Width           =   3435
      End
      Begin Label Label2
         BackStyle       =   0  'Transparent
         Caption         =   "When an item in the list box needs to be drawn (i.e., because of a repaint or if focus or the selection has changed), Windows sends the parent control (or form) a WM_DRAWITEM message.  With that message comes a pointer to a data structure (or Type) that contains all the information needed to draw the item (such as the rectangle in which to draw it)"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   1665
         Left            =   180
         TabIndex        =   4
         Top             =   1680
         Width           =   3435
      End
      Begin Label Label1
         BackStyle       =   0  'Transparent
         Caption         =   "This sample program uses VB Messenger to display an owner-draw list box.  Owner-draw means that all drawing of text and/or pictures that appear in the list box is drawn by the programmer, rather than automatically handled by the list box itself."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   1170
         Left            =   180
         TabIndex        =   3
         Top             =   360
         Width           =   3435
         WordWrap        =   -1  'True
      End
   End
   Begin ListBox lstOwnerDraw
      Height          =   2175
      Left            =   180
      TabIndex        =   0
      Top             =   210
      Width           =   3495
   End
End
Option Explicit

Sub Command1_Click ()
    End
End Sub

Sub DrawItem (lpdis As DRAWITEMSTRUCT)

    Dim rc&
    Dim lpstr$
    Dim hdcSource%, cx%, cy%
    Dim cSelBack&

    'If no items in list box yet, indicate focus for
    'specified rectangle
    If (lpdis.itemID = -1) Then
    DrawFocusRect lpdis.hDC, lpdis.rcItem
    Exit Sub
    End If

    'If Windows wants us to draw the entire item of just change
    'the selection state, we do this stuff
    If (lpdis.itemAction And ODA_DRAWENTIRE) Or (lpdis.itemAction And ODA_SELECT) Then

    'If the item it is selected, fill in the rectangle
    'with the system color for highlight. If not selected,
    'fill the rectangle with the standard window color.
    'Also, the the background and foreground colors
    'appropriately based on selection.
    If (lpdis.itemState And ODS_SELECTED) Then
        cSelBack = GetSysColor(COLOR_HIGHLIGHT)
        rc = SetBkColor(lpdis.hDC, cSelBack)
        rc = SetTextColor(lpdis.hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
        DrawSelectionRect lpdis, cSelBack
    Else
        cSelBack = GetSysColor(COLOR_WINDOW)
        rc = SetBkColor(lpdis.hDC, cSelBack)
        rc = SetTextColor(lpdis.hDC, GetSysColor(COLOR_WINDOWTEXT))
        DrawSelectionRect lpdis, cSelBack
    End If

    'If the item is a directory, use the picDir picture
    'else use the picFile picture.  The hDC property
    'is used for drawing with the Windows API as we will
    'do next.
    If (lstOwnerDraw.ItemData(lpdis.itemID)) Then
        hdcSource = picDir.hDC
    Else
        hdcSource = picFile.hDC
    End If
    'All Windows API calls require that coordinates and sizes
    'be in pixels.
    cx = picDir.Width / Screen.TwipsPerPixelX
    cy = picDir.Height / Screen.TwipsPerPixelY
    'This function copies the image in the picture box
    'to an area specified
    rc = BitBlt(lpdis.hDC, lpdis.rcItem.left, lpdis.rcItem.top, cx, cy, hdcSource, 0, 0, SRCCOPY)

    'Now, draw the text using the DrawText Windows API
    lpdis.rcItem.left = lpdis.rcItem.left + cx + 5
    lpstr = lstOwnerDraw.List(lpdis.itemID)
    rc = DrawText(lpdis.hDC, lpstr, Len(lpstr), lpdis.rcItem, DT_VCENTER Or DT_SINGLELINE)

    'if item has focus, do additional drawing -- dashed border
    If (lpdis.itemState And ODS_FOCUS) Then
        DrawFocusRect lpdis.hDC, lpdis.rcItem
    End If

    Exit Sub

    End If

    'If only focus has changed, display or hide the focus rectangle.
    'DrawFocusRect will display the dotted rectangle if one isn't
    'already there, otherwise if there is one it will clear it.
    If (lpdis.itemAction And ODA_FOCUS) Then
    DrawFocusRect lpdis.hDC, lpdis.rcItem
    Exit Sub
    End If

End Sub

'
'This routine fills an area (a rectangle) with a color
'
Sub DrawSelectionRect (lpdis As DRAWITEMSTRUCT, cSelBack As Long)

    Dim rc&
    Dim hbrSel%, hbrOld%

    hbrSel = CreateSolidBrush(cSelBack)
    hbrOld = SelectObject(lpdis.hDC, hbrSel)
    rc = FillRect(lpdis.hDC, lpdis.rcItem, hbrSel)
    rc = SelectObject(lpdis.hDC, hbrOld)
    rc = DeleteOb